home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / akcl1615.lha / c / sgbc.c < prev    next >
C/C++ Source or Header  |  1992-02-02  |  29KB  |  1,261 lines
  1. /*  Copyright William Schelter. All rights reserved.
  2.     
  3.     Stratified Garbage Collection  (SGC)
  4.  
  5.     Write protects pages to tell which ones have been written
  6. to recently, for more efficient garbage collection.
  7.  
  8. */
  9.  
  10. #ifdef BSD
  11. #include <sys/mman.h>
  12. #define PROT_READ_WRITE (PROT_READ | PROT_WRITE |PROT_EXEC)
  13. #endif
  14. #ifdef AIX3
  15. #include <sys/vmuser.h>
  16. #define PROT_READ RDONLY
  17. #define  PROT_READ_WRITE UDATAKEY
  18. int mprotect();
  19. #endif
  20.  
  21. #include <signal.h>
  22.  
  23. void segmentation_catcher();
  24.  
  25.  
  26. #define sgc_mark_pack_list(u)      \
  27. do {register object xtmp = u;  \
  28.  while (xtmp != Cnil) \
  29.    {if (ON_WRITABLE_PAGE(xtmp)) xtmp->d.m = TRUE; \
  30.      sgc_mark_object(xtmp->c.c_car); \
  31.     xtmp=xtmp->c.c_cdr;}}while(0) 
  32.  
  33.  
  34. #ifdef SDEBUG
  35.   object sdebug;
  36. joe1(){;}
  37. #endif
  38.  
  39. sgc_mark_cons(x)
  40. object x;
  41. {
  42.   cs_check(x);
  43.  
  44.     /*  x is already marked.  */
  45.  
  46. BEGIN:
  47. #ifdef SDEBUG
  48.       if(x==sdebug) joe1();
  49. #endif
  50.       sgc_mark_object(x->c.c_car);
  51. #ifdef OLD
  52.       IF_WRITABLE(x->c.c_car, goto MARK_CAR;);
  53.       goto MARK_CDR;
  54.  
  55.  MARK_CAR:
  56.    if (x->c.c_car->c.m ==0)
  57.     {if (type_of(x->c.c_car) == t_cons)
  58.        {
  59.          x->c.c_car->c.m = TRUE;
  60.          sgc_mark_cons(x->c.c_car);
  61.        }
  62.     else
  63.       sgc_mark_object1(x->c.c_car);}
  64. #endif
  65.  MARK_CDR:  
  66.   x = x->c.c_cdr;
  67.   IF_WRITABLE(x, goto WRITABLE_CDR;);
  68.     return;
  69.  WRITABLE_CDR:
  70.   if (x->d.m) return;
  71.   if (type_of(x) == t_cons) {
  72.         x->c.m = TRUE;
  73.         goto BEGIN;
  74.     }
  75.   sgc_mark_object1(x);
  76. }
  77.  
  78.  
  79. /* Whenever two arrays are linked together by displacement,
  80.    if one is live, the other will be made live */
  81. #define sgc_mark_displaced_field(ar) sgc_mark_object(ar->a.a_displaced)
  82.  
  83.  
  84. /* structures and arrays of type t, need to be marked if their
  85.    bodies are not write protected even if the headers are.
  86.    So we should keep these on pages particular to them.
  87.    Actually we will change structure sets to touch the structure
  88.    header, that way we won't have to keep the headers in memory.
  89.    This takes only 1.47 as opposed to 1.33 microseconds per set.
  90. */
  91. sgc_mark_object1(x)
  92. object x;
  93. {
  94.     int i, j;
  95.     object *p;
  96.     char *cp;
  97.     object y;
  98.  
  99.     cs_check(x);
  100. BEGIN:
  101. #ifdef SDEBUG
  102.     if (x == OBJNULL || !ON_WRITABLE_PAGE(x))
  103.         return;
  104.     IF_WRITABLE(x,goto OK);
  105.     joe();
  106.  
  107.       OK:
  108.     if (x->d.m)
  109.         return;
  110.  
  111.     if(x==sdebug) joe1();
  112. #endif
  113.     x->d.m = TRUE;
  114.     switch (type_of(x)) {
  115.     case t_fixnum:
  116.         break;
  117.  
  118.     case t_ratio:
  119.         sgc_mark_object(x->rat.rat_num);
  120.         x = x->rat.rat_den;
  121.         IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);
  122.  
  123.     case t_shortfloat:
  124.         break;
  125.  
  126.     case t_longfloat:
  127.         break;
  128.  
  129.     case t_complex:
  130.         sgc_mark_object(x->cmp.cmp_imag);
  131.         x = x->cmp.cmp_real;
  132.         IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);
  133.  
  134.     case t_character:
  135.         break;
  136.  
  137.     case t_symbol:
  138.         IF_WRITABLE(x->s.s_plist,if(x->s.s_plist->d.m==0)
  139.                 {x->s.s_plist->d.m=TRUE;
  140.                  sgc_mark_cons(x->s.s_plist);});
  141.         sgc_mark_object(x->s.s_gfdef);
  142.         sgc_mark_object(x->s.s_dbind);
  143. /*        do {int xxx= (((int)(char *)(x->s.s_dbind)-0)>>12);
  144.             if((xxx & (-16384) ==0)
  145.                && (sgc_type_map[xxx] & (4 | 1)))
  146.               {if((x->s.s_dbind)->d.m==0)
  147.              sgc_mark_object1(x->s.s_dbind);}} while(0); */
  148.         if (x->s.s_self == NULL)
  149.             break;
  150.         /* to do */
  151.         if ((int)what_to_collect >= (int)t_contiguous) {
  152.             if (inheap(x->s.s_self)) {
  153.                 if (what_to_collect == t_contiguous)
  154.                     mark_contblock(x->s.s_self,
  155.                                x->s.s_fillp);
  156.             } else  if(SGC_RELBLOCK_P(x->s.s_self))
  157.                 x->s.s_self =
  158.                 copy_relblock(x->s.s_self, x->s.s_fillp);
  159.         }
  160.         break;
  161.  
  162.     case t_package:
  163.         sgc_mark_object(x->p.p_name);
  164.         sgc_mark_object(x->p.p_nicknames);
  165.         sgc_mark_object(x->p.p_shadowings);
  166.         sgc_mark_object(x->p.p_uselist);
  167.         sgc_mark_object(x->p.p_usedbylist);
  168.         if (what_to_collect != t_contiguous)
  169.             break;
  170.         if (x->p.p_internal != NULL)
  171.             mark_contblock((char *)(x->p.p_internal),
  172.                        x->p.p_internal_size*sizeof(object));
  173.         if (x->p.p_external != NULL)
  174.             mark_contblock((char *)(x->p.p_external),
  175.                        x->p.p_external_size*sizeof(object));
  176.         break;
  177.  
  178.     case t_cons:
  179. /*
  180.         sgc_mark_object(x->c.c_car);
  181.         x = x->c.c_cdr;
  182.         goto BEGIN;
  183. */
  184.         sgc_mark_cons(x);
  185.         break;
  186.  
  187.     case t_hashtable:
  188.         sgc_mark_object(x->ht.ht_rhsize);
  189.         sgc_mark_object(x->ht.ht_rhthresh);
  190.         if (x->ht.ht_self == NULL)
  191.             break;
  192.         for (i = 0, j = x->ht.ht_size;  i < j;  i++) {
  193.             sgc_mark_object(x->ht.ht_self[i].hte_key);
  194.             sgc_mark_object(x->ht.ht_self[i].hte_value);
  195.         }
  196.         if ((short)what_to_collect >= (short)t_contiguous) {
  197.             if (inheap(x->ht.ht_self)) {
  198.                 if (what_to_collect == t_contiguous)
  199.                     mark_contblock((char *)(x->ht.ht_self),
  200.                                j * sizeof(struct htent));
  201.             } else if(SGC_RELBLOCK_P(x->ht.ht_self))
  202.                 x->ht.ht_self = (struct htent *)
  203.                 copy_relblock((char *)(x->ht.ht_self),
  204.                           j * sizeof(struct htent));
  205.         }
  206.         break;
  207.  
  208.     case t_array:
  209.         if ((x->a.a_displaced) != Cnil)
  210.           sgc_mark_displaced_field(x);
  211.         if ((int)what_to_collect >= (int)t_contiguous &&
  212.             x->a.a_dims != NULL) {
  213.             if (inheap(x->a.a_dims)) {
  214.                 if (what_to_collect == t_contiguous)
  215.                     mark_contblock((char *)(x->a.a_dims),
  216.                                sizeof(int)*x->a.a_rank);
  217.             } else  if(SGC_RELBLOCK_P(x->a.a_dims))
  218.                 x->a.a_dims = (int *)
  219.                 copy_relblock((char *)(x->a.a_dims),
  220.                           sizeof(int)*x->a.a_rank);
  221.         }
  222.         if ((enum aelttype)x->a.a_elttype == aet_ch)
  223.             goto CASE_STRING;
  224.         if ((enum aelttype)x->a.a_elttype == aet_bit)
  225.             goto CASE_BITVECTOR;
  226.         if ((enum aelttype)x->a.a_elttype == aet_object)
  227.             goto CASE_GENERAL;
  228.  
  229.     CASE_SPECIAL:
  230.         cp = (char *)(x->fixa.fixa_self);
  231.         if (cp == NULL)
  232.             break;
  233.         /* set j to the size in char of the body of the array */
  234.         
  235.         switch((enum aelttype)x->a.a_elttype){
  236.         case aet_lf:
  237.           j= sizeof(longfloat)*x->lfa.lfa_dim;
  238.           if (((int)what_to_collect >= (int)t_contiguous) &&
  239.             !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self))
  240.             ROUND_RB_POINTERS_DOUBLE;
  241.           break;
  242.         case aet_char:
  243.         case aet_uchar:
  244.           j=sizeof(char)*x->a.a_dim;
  245.           break;
  246.         case aet_short:
  247.         case aet_ushort:
  248.           j=sizeof(short)*x->a.a_dim;
  249.           break;
  250.         default:
  251.           j=sizeof(fixnum)*x->fixa.fixa_dim;}
  252.  
  253.         goto COPY;
  254.  
  255.     CASE_GENERAL:
  256.         p = x->a.a_self;
  257.         if (p == NULL
  258. #ifdef HAVE_ALLOCA
  259.                    || (char *)p >= core_end
  260. #endif  
  261.             
  262.             )
  263.             break;
  264.         if (x->a.a_displaced->c.c_car == Cnil)
  265.             for (i = 0, j = x->a.a_dim;  i < j;  i++)
  266.               if (ON_WRITABLE_PAGE(&p[i]))
  267.                 sgc_mark_object(p[i]);
  268.         cp = (char *)p;
  269.         j *= sizeof(object);
  270.     COPY:
  271.         if ((int)what_to_collect >= (int)t_contiguous) {
  272.             if (inheap(cp)) {
  273.                 if (what_to_collect == t_contiguous)
  274.                     mark_contblock(cp, j);
  275.             }
  276.             else if (!SGC_RELBLOCK_P(cp)) ;
  277.             else if (x->a.a_displaced == Cnil)
  278.                 x->a.a_self = (object *)copy_relblock(cp, j);
  279.             else if (x->a.a_displaced->c.c_car == Cnil) {
  280.                 i = (int)(object *)copy_relblock(cp, j)
  281.                   - (int)(x->a.a_self);
  282.                 adjust_displaced(x, i);
  283.             }
  284.         }
  285.         break;
  286.  
  287.     case t_vector:
  288.         if ((x->v.v_displaced) != Cnil)
  289.           sgc_mark_displaced_field(x);
  290.         if ((enum aelttype)x->v.v_elttype == aet_object)
  291.             goto CASE_GENERAL;
  292.         else
  293.             goto CASE_SPECIAL;
  294.  
  295.         case t_bignum:
  296.         if ((int)what_to_collect >= (int)t_contiguous) {
  297.         j = x->big.big_length;
  298.         cp = (char *)x->big.big_self;
  299.         if (cp == NULL)
  300.             break;
  301.         if  (j != lg(MP(x))  &&
  302.               /* we don't bother to zero this register,
  303.              and its contents may get over written */
  304.               ! (x ==  big_register_1 &&
  305.              (int)(cp) <= top &&
  306.              (int) cp >= bot))
  307.           
  308.           printf("bad length 0x%x ",x);
  309.         j = j * sizeof(int);
  310.                 cp = (char *)MP(x);
  311.         if (inheap(cp)) {
  312.           if (what_to_collect == t_contiguous)
  313.             mark_contblock(cp, j);
  314.         } else 
  315.           x->big.big_self = (long *)copy_relblock(cp, j);}
  316.         break;
  317.         
  318.  
  319.     CASE_STRING:
  320.     case t_string:
  321.         if ((x->st.st_displaced) != Cnil)
  322.           sgc_mark_displaced_field(x);
  323.         j = x->st.st_dim;
  324.         cp = x->st.st_self;
  325.         if (cp == NULL)
  326.             break;
  327.  
  328.     COPY_STRING:
  329.         if ((int)what_to_collect >= (int)t_contiguous) {
  330.             if (inheap(cp)) {
  331.                 if (what_to_collect == t_contiguous)
  332.                     mark_contblock(cp, j);
  333.             }
  334.             else if (!SGC_RELBLOCK_P(cp)) ;
  335.             else if (x->st.st_displaced == Cnil)
  336.                 x->st.st_self = copy_relblock(cp, j);
  337.             else if (x->st.st_displaced->c.c_car == Cnil) {
  338.                 i = copy_relblock(cp, j) - cp;
  339.                 adjust_displaced(x, i);
  340.             }
  341.         }
  342.         break;
  343.  
  344.     CASE_BITVECTOR:
  345.     case t_bitvector:
  346.         if ((x->bv.bv_displaced) != Cnil)
  347.           sgc_mark_displaced_field(x);
  348. /* We make bitvectors multiple of sizeof(int) in size allocated
  349.  Assume 8 = number of bits in char */
  350.  
  351. #define W_SIZE (8*sizeof(int))
  352.         j= sizeof(int) *
  353.            ((x->bv.bv_offset + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
  354.         cp = x->bv.bv_self;
  355.         if (cp == NULL)
  356.             break;
  357.         goto COPY_STRING;
  358.  
  359.     case t_structure:
  360.         sgc_mark_object(x->str.str_def);
  361.         p = x->str.str_self;
  362.         if (p == NULL)
  363.             break;
  364.         {object def=x->str.str_def;
  365.          unsigned char * s_type = &SLOT_TYPE(def,0);
  366.          unsigned short *s_pos= & SLOT_POS(def,0);
  367.          for (i = 0, j = S_DATA(def)->length;  i < j;  i++)
  368.            if (s_type[i]==0 &&
  369.                ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i]))
  370.                )
  371.              sgc_mark_object(STREF(object,x,s_pos[i]));
  372.          if ((int)what_to_collect >= (int)t_contiguous) {
  373.              if (inheap(x->str.str_self)) {
  374.                if (what_to_collect == t_contiguous)
  375.              mark_contblock((char *)p,
  376.                     S_DATA(def)->size);
  377.  
  378.              } else if(SGC_RELBLOCK_P(p))
  379.                x->str.str_self = (object *)
  380.               copy_relblock((char *)p, S_DATA(def)->size);
  381.            }}
  382.         break;
  383.  
  384.     case t_stream:
  385.         switch (x->sm.sm_mode) {
  386.         case smm_input:
  387.         case smm_output:
  388.         case smm_io:
  389.         case smm_probe:
  390.             sgc_mark_object(x->sm.sm_object0);
  391.             sgc_mark_object(x->sm.sm_object1);
  392.             if (saving_system)
  393.               {FILE *fp = x->sm.sm_fp;
  394.                  if (fp != 0 && fp != stdin && fp !=stdout
  395.                  )
  396.                  {fclose(fp);
  397.                   x->sm.sm_fp=0;
  398.                 }}
  399.             else
  400.             if (what_to_collect == t_contiguous &&
  401.                 x->sm.sm_fp &&
  402.                 x->sm.sm_buffer)
  403.                 mark_contblock(x->sm.sm_buffer, BUFSIZ);
  404.             break;
  405.  
  406.         case smm_synonym:
  407.             sgc_mark_object(x->sm.sm_object0);
  408.             break;
  409.  
  410.         case smm_broadcast:
  411.         case smm_concatenated:
  412.             sgc_mark_object(x->sm.sm_object0);
  413.             break;
  414.  
  415.         case smm_two_way:
  416.         case smm_echo:
  417.             sgc_mark_object(x->sm.sm_object0);
  418.             sgc_mark_object(x->sm.sm_object1);
  419.             break;
  420.  
  421.         case smm_string_input:
  422.         case smm_string_output:
  423.             sgc_mark_object(x->sm.sm_object0);
  424.             break;
  425. #ifdef USER_DEFINED_STREAMS
  426.                case smm_user_defined:
  427.             sgc_mark_object(x->sm.sm_object0);
  428.             sgc_mark_object(x->sm.sm_object1);
  429.             break;
  430. #endif
  431.         default:
  432.             error("mark stream botch");
  433.         }
  434.         break;
  435.  
  436.     case t_random:
  437.         break;
  438.  
  439.     case t_readtable:
  440.         if (x->rt.rt_self == NULL)
  441.             break;
  442.         if (what_to_collect == t_contiguous)
  443.             mark_contblock((char *)(x->rt.rt_self),
  444.                        RTABSIZE*sizeof(struct rtent));
  445.         for (i = 0;  i < RTABSIZE;  i++) {
  446.             sgc_mark_object(x->rt.rt_self[i].rte_macro);
  447.             if (x->rt.rt_self[i].rte_dtab != NULL) {
  448. /**/
  449.     if (what_to_collect == t_contiguous)
  450.         mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),
  451.                    RTABSIZE*sizeof(object));
  452.     for (j = 0;  j < RTABSIZE;  j++)
  453.         sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]);
  454. /**/
  455.             }
  456.         }
  457.         break;
  458.  
  459.     case t_pathname:
  460.         sgc_mark_object(x->pn.pn_host);
  461.         sgc_mark_object(x->pn.pn_device);
  462.         sgc_mark_object(x->pn.pn_directory);
  463.         sgc_mark_object(x->pn.pn_name);
  464.         sgc_mark_object(x->pn.pn_type);
  465.         sgc_mark_object(x->pn.pn_version);
  466.         break;
  467.  
  468.     case t_cfun:
  469.         case t_sfun:
  470.         case t_vfun:
  471.     case t_gfun:    
  472.         sgc_mark_object(x->cf.cf_name);
  473.         sgc_mark_object(x->cf.cf_data);
  474.         break;
  475.         
  476.         case t_cfdata:
  477.  
  478.             if (x->cfd.cfd_self != NULL)
  479.           {int i=x->cfd.cfd_fillp;
  480.            while(i-- > 0)
  481.              sgc_mark_object(x->cfd.cfd_self[i]);}
  482.         if (x->cfd.cfd_start == NULL)
  483.             break;
  484.         if (what_to_collect == t_contiguous) {
  485.             if (!MAYBE_DATA_P((x->cfd.cfd_start)) ||
  486.                 get_mark_bit((int *)(x->cfd.cfd_start)))
  487.                 break;
  488.             mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);}
  489.         break;
  490.     case t_cclosure:
  491.         sgc_mark_object(x->cc.cc_name);
  492.         sgc_mark_object(x->cc.cc_env);
  493.                 sgc_mark_object(x->cc.cc_data);
  494.         if (what_to_collect == t_contiguous) {
  495.           if (x->cc.cc_turbo != NULL)
  496.             mark_contblock((char *)(x->cc.cc_turbo-1),
  497.                                    (1+fix(*(x->cc.cc_turbo-1)))*sizeof(object));
  498.         }
  499.         break;
  500.  
  501.     case t_spice:
  502.         break;
  503.         case t_fat_string:
  504.         mark_fat_string(x);
  505.         break;
  506.         case t_dclosure:
  507.                 break;
  508.     default:
  509. #ifdef DEBUG
  510.         if (debug)
  511.             printf("\ttype = %d\n", type_of(x));
  512. #endif
  513.         error("mark botch");
  514.     }
  515.     
  516. }
  517.  
  518.  
  519.  
  520. sgc_mark_stack_carefully(top,bottom,offset)
  521. int *bottom,*top;
  522. {int p,m,pageoffset;
  523.  object x;
  524.  struct typemanager *tm;
  525.  register int *j;
  526.  
  527.  /* if either of these happens we are marking the C stack
  528.     and need to use a local */
  529.  
  530.  if (top==0) top = c_stack_where;
  531.  if (bottom==0) bottom= c_stack_where;
  532.  
  533.  /* On machines which align local pointers on multiple of 2 rather
  534.     than 4 we need to mark twice
  535.    */
  536.  
  537.  if (offset) {sgc_mark_stack_carefully(bottom,(((char *) top) +offset),0);}
  538.  for (j=top ; j >= bottom ; j--)
  539.    {if (VALID_DATA_ADDRESS_P(*j)
  540.     && type_map[(p=page(*j))]< (char)t_end)
  541.       {pageoffset=((char *)*j - pagetochar(p));
  542.        tm=tm_of((enum type) type_map[p]);
  543.        x= (object)
  544.      ((char *)(*j) -
  545.       ((pageoffset=((char *)*j - pagetochar(p))) %
  546.        tm->tm_size));
  547.        if ((pageoffset <  (tm->tm_size * tm->tm_nppage))
  548.        && (m=x->d.m) != FREE)
  549.        {if (m==TRUE) continue;
  550.       if (m!=0)
  551.         {fprintf(stdout,
  552.              "**bad value %d of d.m in gbc page %d skipping mark**"
  553.              ,m,p);fflush(stdout);
  554.          continue;
  555.        };
  556.       sgc_mark_object(x);}}}}
  557.  
  558.  
  559. sgc_mark_phase()
  560. {
  561.     STATIC object *p;
  562.     STATIC int i, j, k, n;
  563.     STATIC struct package *pp;
  564.     STATIC object s, l, *lp;
  565.     STATIC bds_ptr bdp;
  566.     STATIC frame_ptr frp;
  567.     STATIC ihs_ptr ihsp;
  568.     STATIC char *cp;
  569.  
  570.     sgc_mark_object(Cnil);
  571.     sgc_mark_object(Ct);
  572.  
  573.     
  574.  
  575.     /* mark all non recent data on writable pages */
  576.     {int t,i=page(heap_end);
  577.      struct typemanager *tm;
  578.      char *p;
  579.      
  580.      while (--i >= 0)
  581.        {if (WRITABLE_PAGE_P(i)
  582.           && (t=type_map[i]) < (int) t_end);
  583.        else continue;
  584.         tm=tm_of(t);
  585.         p=pagetochar(i);
  586.         if ( t == t_cons) 
  587.           for (j = tm->tm_nppage; --j >= 0; p += sizeof(struct cons))
  588.           {object x = (object) p; 
  589.            if (SGC_OR_M(x)) continue;
  590.            if (x->d.t==t_cons) {x->d.m = TRUE; sgc_mark_cons(x);}
  591.            else
  592.          sgc_mark_object1(x);
  593.          }
  594.         else
  595.           {int size=tm->tm_size;
  596.            for (j = tm->tm_nppage; --j >= 0; p += size)
  597.          {object x = (object) p; 
  598.           if (SGC_OR_M(x)) continue;
  599.           sgc_mark_object1(x);
  600.         }}}}
  601.  
  602.  
  603.     sgc_mark_stack_carefully(vs_top-1,vs_org,0);
  604.     clear_stack(vs_top,vs_limit);
  605.     sgc_mark_stack_carefully(MVloc,MVloc+(sizeof(MVloc)/sizeof(object)),0);
  606.     /* 
  607.     for (p = vs_org;  p < vs_top;  p++) {
  608.       if (p && (inheap(*p)))
  609.         sgc_mark_object(*p);
  610.     }
  611.     */
  612. #ifdef DEBUG
  613.     if (debug) {
  614.         printf("value stack marked\n");
  615.         fflush(stdout);
  616.     }
  617. #endif
  618.  
  619.     for (bdp = bds_org;  bdp<=bds_top;  bdp++) {
  620.          sgc_mark_object(bdp->bds_sym);
  621.         sgc_mark_object(bdp->bds_val);
  622.     }
  623.  
  624.     for (frp = frs_org;  frp <= frs_top;  frp++)
  625.         sgc_mark_object(frp->frs_val);
  626.  
  627.     for (ihsp = ihs_org;  ihsp <= ihs_top;  ihsp++)
  628.         sgc_mark_object(ihsp->ihs_function);
  629.  
  630.     for (i = 0;  i < mark_origin_max;  i++)
  631.         sgc_mark_object(*mark_origin[i]);
  632.     for (i = 0;  i < mark_origin_block_max;  i++)
  633.         for (j = 0;  j < mark_origin_block[i].mob_size;  j++)
  634.             sgc_mark_object(mark_origin_block[i].mob_addr[j]);
  635.  
  636.     for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link)
  637.         sgc_mark_object((object)pp);
  638. #ifdef KCLOVM
  639.     if (ovm_process_created)
  640.       sgc_mark_all_stacks();
  641. #endif
  642.  
  643.  
  644.     if (debug) {
  645.         printf("symbol navigation\n");
  646.         fflush(stdout);
  647.     }
  648.     {int size;
  649.      
  650.      for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link) {
  651.                     size = pp->p_internal_size;
  652.             if (pp->p_internal != NULL)
  653.                 for (i = 0;  i < size;  i++)
  654.                     sgc_mark_pack_list(pp->p_internal[i]);
  655.             size = pp->p_external_size;
  656.             if (pp->p_external != NULL)
  657.                 for (i = 0;  i < size;  i++)
  658.                     sgc_mark_pack_list(pp->p_external[i]);
  659.         }}
  660.  
  661.  
  662.     mark_c_stack(0,N_RECURSION_REQD,sgc_mark_stack_carefully);
  663.  
  664. }
  665.  
  666. sgc_sweep_phase()
  667. {
  668.     STATIC int i, j, k;
  669.     STATIC object x;
  670.     STATIC char *p;
  671.     STATIC int *ip;
  672.     STATIC struct typemanager *tm;
  673.     STATIC object f;
  674.     int size;
  675.  
  676.     Cnil->s.m = FALSE;
  677.     Ct->s.m = FALSE;
  678.  
  679. #ifdef DEBUG
  680.     if (debug)
  681.         printf("type map\n");
  682. #endif
  683.     for (i = 0;  i < maxpage;  i++) {
  684.         if (type_map[i] == (int)t_contiguous) {
  685.             if (debug) {
  686.                 printf("-");
  687.             /*
  688.                 fflush(stdout);
  689.             */
  690.                 continue;
  691.             }
  692.         }
  693.         if (type_map[i] >= (int)t_end)
  694.             continue;
  695.  
  696.         tm = tm_of((enum type)type_map[i]);
  697.  
  698.     /*
  699.         general sweeper
  700.     */
  701.  
  702. #ifdef DEBUG
  703.         if (debug) {
  704.             printf("%c", tm->tm_name[0]);
  705.         /*
  706.             fflush(stdout);
  707.         */
  708.         }
  709. #endif
  710.         if (!WRITABLE_PAGE_P(i)) continue;
  711.         p = pagetochar(i);
  712.         f = tm->tm_free;
  713.         k = 0;
  714.         size=tm->tm_size;
  715.         if (SGC_PAGE_P(i)) {
  716.         for (j = tm->tm_nppage; --j >= 0;  p += size) {
  717.             x = (object)p;
  718.  
  719.             if (x->d.m == FREE)
  720.                 continue;
  721.             else if (x->d.m) {
  722.                 x->d.m = FALSE;
  723.                 continue;
  724.             }
  725.             if(x->d.s == SGC_NORMAL)
  726.               continue;
  727.             
  728.             /* it is ok to free x */
  729.             
  730. #ifdef OLD_DISPLACE
  731.             /* old_displace: from might be free, to not */
  732.             if(x->d.t >=t_array && x->d.t <= t_bitvector)
  733.               {
  734.                 /*            case t_array:
  735.                         case t_vector:
  736.                         case t_string:
  737.                         case t_bitvector:
  738.                         */            
  739.                 if (x->a.a_displaced->c.c_car != Cnil)
  740.                   {undisplace(x);
  741.          /* The cons x->a.a_displaced cons has been saved,
  742.             so as to save the pointer to x->a.a_displaced->c.c_car;
  743.             However any arrays in its cdr, must have been
  744.             freed, or we would not be freeing x.   To avoid
  745.             having a cons with trash in the cdr we set the
  746.             cdr to nil
  747.             */                    
  748.                  x->a.a_displaced->c.c_cdr = Cnil;}
  749.             }
  750. #endif OLD_DISPLACE
  751.             ((struct freelist *)x)->f_link = f;
  752.             x->d.m = FREE;
  753.             x->d.s = (int)SGC_RECENT;
  754.             f = x;
  755.             k++;
  756.         }
  757.         tm->tm_free = f;
  758.         tm->tm_nfree += k;
  759.           }
  760.         else /*non sgc_page */
  761.         for (j = tm->tm_nppage; --j >= 0;  p += size) {
  762.             x = (object)p;
  763.  
  764.             if (x->d.m == TRUE) x->d.m=FALSE;
  765.         }
  766.           
  767.  
  768.     NEXT_PAGE:
  769.         ;
  770.     }
  771. #ifdef DEBUG
  772.     if (debug) {
  773.         putchar('\n');
  774.         fflush(stdout);
  775.     }
  776. #endif
  777. }
  778.  
  779.  
  780. sgc_contblock_sweep_phase()
  781. {
  782.     STATIC int i, j;
  783.     STATIC char *s, *e, *p, *q;
  784.     STATIC struct contblock *cbp;
  785.  
  786.     cb_pointer = NULL;
  787.     ncb = 0;
  788.     for (i = 0;  i < maxpage;) {
  789.         if (type_map[i] != (int)t_contiguous
  790.             || !SGC_PAGE_P(i))
  791.              {
  792.             i++;
  793.             continue;
  794.         }
  795.         for (j = i+1;
  796.              j < maxpage && type_map[j] == (int)t_contiguous
  797.              && SGC_PAGE_P(j)
  798.              ;
  799.              j++)
  800.             ;    
  801.         s = pagetochar(i);
  802.         e = pagetochar(j);
  803.         for (p = s;  p < e;) {
  804.             if (get_mark_bit((int *)p)) {
  805.                 p += 4;
  806.                 continue;
  807.             }
  808.             q = p + 4;
  809.             while (q < e) {
  810.                 if (!get_mark_bit((int *)q)) {
  811.                     q += 4;
  812.                     continue;
  813.                 }
  814.                 break;
  815.             }
  816.             insert_contblock(p, q - p);
  817.             p = q + 4;
  818.         }
  819.         i = j + 1;
  820.     }
  821. #ifdef DEBUG
  822.     if (debug) {
  823.         for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
  824.             printf("%d-byte contblock\n", cbp->cb_size);
  825.         fflush(stdout);
  826.     }
  827. #endif
  828. }
  829.  
  830.  
  831.  
  832. #define PAGE_ROUND_UP(adr) \
  833.     ((char *)(PAGESIZE*(((int)(adr)+PAGESIZE -1) >> PAGEWIDTH)))
  834.  
  835. char *old_rb_start;
  836.  
  837. #undef tm
  838.  int bug1,bug2;
  839.  
  840.  
  841. #ifdef SDEBUG
  842. sgc_count(yy)
  843.      object yy;
  844. {int count=0;
  845.  object y=yy;
  846.  while(y)
  847.    {count++;
  848.     y=F_LINK(y);}
  849.  printf("[length %x = %d]",yy,count);
  850.  fflush(stdout);
  851. }
  852.  
  853. #endif
  854. /* count writable pages excluding the hole */
  855. sgc_count_writable(end)
  856.      int end;
  857. { int j = first_protectable_page -1;
  858.   int count = 0;
  859.   int hp_end= page(heap_end);
  860.   while(j++ < hp_end)
  861.     if (WRITABLE_PAGE_P(j)) count++;
  862.   j= page(rb_start);
  863.   while(j++ < end)
  864.     if (WRITABLE_PAGE_P(j)) count++;
  865.   return count;}
  866.  
  867.  
  868. sgc_count_type(t)
  869.      int t;
  870. {int j = first_protectable_page -1;
  871.   int end = page(core_end);
  872.   int count=0;
  873.   while(j++ < end)
  874.     if (type_map[j]==t && SGC_PAGE_P(j))
  875.       count++;
  876.   return count;}
  877.  
  878.  
  879.  
  880.  
  881.  
  882. sgc_start()
  883. {int i;
  884.  int np;
  885.  int bug;
  886.  short free_map[MAXPAGE];
  887.  object f, fr[(int)t_end];
  888.  struct typemanager *tm;
  889.  int npages;
  890.  if (sgc_type_map[page((&sgc_type_map[0]))] != SGC_PERM_WRITABLE )
  891.    {perm_writable(&sgc_type_map[0],sizeof(sgc_type_map));
  892.   }
  893.  if (sgc_enabled)
  894.      return 1;
  895.  sgc_type_map[0]=0;
  896. AGAIN:
  897.  i=npages=page(core_end);
  898.  while (i--> 0)
  899.    sgc_type_map[i] = sgc_type_map[i]  & SGC_PERM_WRITABLE ;
  900.  
  901.  for (i= t_start; i < t_contiguous ; i++)
  902.    if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc))
  903.      FIND_FREE_PAGES:
  904.      {
  905.        int maxp=0;
  906.        int j;
  907.        int minfree = tm->tm_sgc_minfree;
  908.        int count,tm_sgc;
  909.        bzero(free_map,npages*sizeof(short));
  910.        f = tm->tm_free;
  911.        count=0;
  912.        while (f!=0)
  913.      {free_map[j=page(f)]++;
  914.       if (j>=maxp) maxp=j;
  915. #ifdef DEBUG
  916.       count++;
  917. #endif      
  918.       f= F_LINK(f);
  919.     }
  920. #ifdef DEBUG       
  921.        if (count!=tm->tm_nfree)
  922.      {printf("[Count differed type(%d)nfree= %d in freelist %d]\n"
  923.          ,tm->tm_type,tm->tm_nfree,
  924.          count);fflush(stdout);}
  925. #endif       
  926.        for(j=0,count=0; j <= maxp ;j++)
  927.      {if (free_map[j] >= minfree)
  928.         {sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE);
  929.          ++count;
  930.         if (count >= tm->tm_sgc_max)
  931.            break; 
  932.        }}
  933.  
  934.        /* don't do any more allocations  for this type if saving system */
  935.        if (saving_system) continue;
  936.        
  937.        if (count < tm->tm_sgc)
  938.      /* try to get some more free pages of type i */
  939.      { int n = tm->tm_sgc - count;
  940.        int again=0,nfree = tm->tm_nfree;
  941.        char *p=alloc_page(n);
  942.        if (tm->tm_nfree > nfree) again=1;  /* gc freed some objects */
  943.        while (n-- > 0)
  944.          {(sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0);
  945.           p += PAGESIZE;}
  946.        if (again) goto FIND_FREE_PAGES;     }}
  947.   /* Now  allocate the sgc relblock.   We do this as the tail
  948.     end of the ordinary rb.     */  
  949.   {int want;
  950.   char *new;
  951.   tm=tm_of(t_relocatable);
  952.   want =((int) (rb_end - rb_pointer) >> PAGEWIDTH);
  953.   if (want < tm->tm_sgc) want = tm->tm_sgc;
  954.    else { want  = (want < 4 ? want : want -2);}
  955.  
  956.  FINALE:
  957.   {old_rb_start=rb_start;
  958.    if(!saving_system)
  959.    { new=alloc_relblock(want*PAGESIZE);
  960.     new= PAGE_ROUND_UP(new);
  961.     rb_start=rb_pointer=new;
  962.   }}}
  963.    /* the relblock has been allocated */
  964.  
  965.   /* now move the sgc free lists into place.   alt_free should
  966.      contain the others */
  967.  
  968.   for (i= t_start; i < t_contiguous ; i++)
  969.     if ((bug1= TM_BASE_TYPE_P(i))
  970.     && (np=(tm=tm_of(i))->tm_sgc))
  971.       {object f=tm->tm_free ,x,y,next;
  972.        int count=0;
  973.        x=y=0;
  974.        bug2=(tm_table[i].tm_type == (enum type) i);
  975.       while (f!=0)
  976.         {next=F_LINK(f);
  977. #ifdef SDEBUG         
  978.          if (f->d.m!=FREE)
  979.            printf("Not FREE in freelist f=%d",f);
  980. #endif
  981.          if (ON_SGC_PAGE(f))
  982.            { F_LINK(f) =x;
  983.          f->d.s = SGC_RECENT;
  984.          x=f;
  985.          count++;
  986.            }
  987.          else
  988.            {F_LINK(f)=y;
  989.         f->d.s = SGC_NORMAL;
  990.         y=f;}
  991.          f=next;
  992.        }
  993.     tm->tm_free = x;
  994.     tm->tm_alt_free = y;
  995.     tm->tm_alt_nfree = tm->tm_nfree - count;
  996.     tm->tm_nfree=count;
  997.      }
  998.    
  999.    /* Whew.   We have now allocated the sgc space
  1000.       and modified the tm_table;
  1001.       Turn  memory protection on for the pages which are writable.
  1002.     */
  1003.    memory_protect(1);
  1004.    sgc_enabled=1;
  1005.   if(siVnotify_gbc->s.s_dbind != Cnil)
  1006.    {printf("[SGC on]"); fflush(stdout);}
  1007.  
  1008. }
  1009.  
  1010. sgc_quit()
  1011. { struct typemanager *tm;
  1012.   int i,np;
  1013.   memory_protect(0);
  1014.   if(siVnotify_gbc->s.s_dbind != Cnil)
  1015.    {printf("[SGC off]"); fflush(stdout);}
  1016.   if (sgc_enabled==0) return 0;
  1017.   sgc_enabled=0;
  1018.   rb_start = old_rb_start;
  1019.   for (i= t_start; i < t_contiguous ; i++)
  1020.    if (TM_BASE_TYPE_P(i))
  1021.      {tm=tm_of(i);
  1022.      if (np=tm->tm_sgc)
  1023.        {object f,y;
  1024.     f=tm->tm_free;
  1025.     if (f==0) tm->tm_free=tm->tm_alt_free;
  1026.     else
  1027.       /* tack the alt_free onto the end of free */
  1028.       {
  1029. #ifdef SDEBUG
  1030.         int count=0;
  1031.         f=tm->tm_free;
  1032.         while(y= F_LINK(f))
  1033.           {if(y->d.s != SGC_RECENT)
  1034.         printf("[bad %d]",y);
  1035.            count++; f=y;}
  1036.  
  1037.         count=0;
  1038.         if (f=tm->tm_alt_free)
  1039.           while(y= F_LINK(f))
  1040.         {
  1041.           if(y->d.s != SGC_NORMAL)
  1042.             printf("[alt_bad %d]",y);
  1043.           count++; f=y;}
  1044.         
  1045. #endif
  1046.         f=tm->tm_free;
  1047.         while(y= F_LINK(f))
  1048.          f=y;
  1049.        F_LINK(f)=tm->tm_alt_free;
  1050.        }
  1051.     /* tm->tm_free has all of the free objects */
  1052.     tm->tm_nfree += tm->tm_alt_nfree;
  1053.     tm->tm_alt_nfree = 0;
  1054.     tm->tm_alt_free = 0;
  1055.     
  1056.     /* remove the recent flag from any objects on sgc pages */
  1057.     {int hp=page(heap_end);
  1058.      int i,j;
  1059.      char t = (char) tm->tm_type;
  1060.      char *p;
  1061.            for (i=0 ; i < hp; i++)
  1062.          if (type_map[i]==t && (sgc_type_map[i] & SGC_PAGE_FLAG))
  1063.                for (p= pagetochar(i),j = tm->tm_nppage;
  1064.              j > 0; --j, p += tm->tm_size)
  1065.           {((object) p)->d.s = SGC_NORMAL;}}
  1066.  
  1067.  
  1068.  
  1069.       }}
  1070. }
  1071.  
  1072. void
  1073. make_writable(beg,i)
  1074.      int beg,i;
  1075. {if (i > beg)
  1076.    {beg=ROUND_DOWN_PAGE_NO(beg);
  1077.     i=ROUND_UP_PAGE_NO(i);
  1078.     {int k=beg;
  1079.      while(k <i )
  1080.        sgc_type_map[k++] |= SGC_TEMP_WRITABLE;
  1081.      }
  1082.     sgc_mprotect(beg, i-beg, SGC_WRITABLE);
  1083.     ;}
  1084. }
  1085.  
  1086. int debug_fault =0;
  1087. int fault_count =0;
  1088. extern char *etext;
  1089. void
  1090. memprotect_handler(sig, code, scp, addr)
  1091.           int sig, code;
  1092.           struct sigcontext *scp;
  1093.           char *addr;     
  1094. {int p;
  1095.  int j=page_multiple;
  1096. #ifdef GET_FAULT_ADDR
  1097.  addr=GET_FAULT_ADDR(sig,code,scp,addr);
  1098.  debug_fault = (int) addr;
  1099. #ifdef DEBUG_MPROTECT
  1100.  printf("fault:0x%x [%d] (%d)",addr,page(addr),addr >= core_end);
  1101. #endif 
  1102.  if (addr >= core_end || (unsigned int)addr < DBEGIN)
  1103.    {if (fault_count > 300) error("fault count to high");
  1104.       fault_count ++;
  1105.         INSTALL_MPROTECT_HANDLER;
  1106.     return;}
  1107.    
  1108. #endif 
  1109.  p = page(addr);
  1110.  p = ROUND_DOWN_PAGE_NO(p);
  1111.  if (p >= first_protectable_page
  1112.      && addr < core_end
  1113.      && !(WRITABLE_PAGE_P(p)))
  1114.    {/*   CHECK_RANGE(p,1); */
  1115. #ifdef DEBUG_MPROTECT
  1116.      printf("mprotect(0x%x,%x,0x%x)\n",pagetochar(p),page_multiple * PAGESIZE, sbrk(0));
  1117.      fflush(stdout);
  1118. #endif     
  1119.      mprotect(pagetochar(p),page_multiple * PAGESIZE, PROT_READ_WRITE);
  1120.     while (--j >= 0)
  1121.       sgc_type_map[p+j]=      sgc_type_map[p+j] | SGC_TEMP_WRITABLE;
  1122.  
  1123. #ifndef  BSD
  1124.  INSTALL_MPROTECT_HANDLER;
  1125. #endif
  1126.  
  1127.     return;
  1128.   }
  1129.  
  1130. #ifndef  BSD
  1131.  INSTALL_MPROTECT_HANDLER;
  1132. #endif
  1133. /* if (SIGSEGV == SIGPROTV) */
  1134.  END:
  1135.  segmentation_catcher();
  1136.  return;
  1137. }
  1138.  
  1139. sgc_mprotect(pbeg,n,writable)
  1140. { /* CHECK_RANGE(pbeg,n);  */
  1141. #ifdef DEBUG_MPROTECT
  1142.   printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE,
  1143.      (writable  & SGC_WRITABLE ? "writable" : "not writable"));
  1144.   fflush(stdout);
  1145. #endif  
  1146.   if(mprotect(pagetochar(pbeg),n*PAGESIZE,
  1147.          (writable & SGC_WRITABLE ? PROT_READ_WRITE : PROT_READ)))
  1148.    FEerror("Couldn't protect");}
  1149.  
  1150.  
  1151. /* for page numbers from beg below end,
  1152.    if one page in a a page_multiple grouping is writable,the
  1153.    rest must be */
  1154.  
  1155. fix_for_page_multiple(beg,end)
  1156. {int i,j;
  1157.  char *p;
  1158.  int writable;
  1159.  beg = ROUND_DOWN_PAGE_NO(beg);
  1160.  for (i = beg ; i < end; i = i+ page_multiple){
  1161.    p = sgc_type_map + i;
  1162.    j = page_multiple;
  1163.    writable = ((*p++) & SGC_WRITABLE);
  1164.    if (writable)
  1165.      /* all pages must be */
  1166.      { while (--j)
  1167.      if (((*p++) & SGC_WRITABLE)  == 0)
  1168.        goto FIXIT;}
  1169.    else
  1170.      { while (--j)
  1171.      if ((*p++) & SGC_WRITABLE ) 
  1172.        goto FIXIT;}
  1173.    continue;
  1174.  FIXIT:
  1175.    j = page_multiple;
  1176.    p = sgc_type_map + i;
  1177.    while (--j >= 0 )
  1178.      { (*p++) |= SGC_WRITABLE;}}}
  1179.      
  1180.  
  1181. memory_protect(on)
  1182.      int on;
  1183. { int i,beg,end= page(core_end);
  1184.   int writable=1;
  1185.   extern void   install_segmentation_catcher();
  1186.   if (first_protectable_page==0)
  1187.   {
  1188.     for (i=page_multiple; i< maxpage ; i++)
  1189.       if (type_map[i]!=t_other)
  1190.     break;
  1191.       else {
  1192.     /* We want page(0) to be non writable since that
  1193.        is the only check for 0 pointer in sgc */
  1194.       sgc_type_map[i] = SGC_PERM_WRITABLE;}
  1195.     first_protectable_page= ROUND_DOWN_PAGE_NO(i);}
  1196.   if(page_multiple > 1)
  1197.     fix_for_page_multiple(first_protectable_page,end);
  1198.     /* turning it off */
  1199.   if (on==0) {sgc_mprotect((first_protectable_page),
  1200.                (end - first_protectable_page), SGC_WRITABLE);
  1201.           install_segmentation_catcher();
  1202.           return;}
  1203.   /* write protect some pages by first write protecting them
  1204.      all and then selectively disabling */
  1205. /*  sgc_mprotect((first_protectable_page),
  1206.                (end - first_protectable_page), 0);
  1207. */
  1208.   INSTALL_MPROTECT_HANDLER;
  1209.   beg=first_protectable_page;
  1210.   writable = WRITABLE_PAGE_P(beg);
  1211.   for (i=beg ; ++i<= end; )
  1212.     {int wri = WRITABLE_PAGE_P(i);
  1213.      if ((wri==0 && writable)
  1214.          || (writable ==0  && wri)
  1215.      || i == end)
  1216.        /* it is changing */
  1217.        {if (writable)
  1218.       make_writable(beg,i);
  1219.     else
  1220.      sgc_mprotect(beg,i-beg,writable);
  1221.     writable = wri;
  1222.     beg = i;}
  1223.    }
  1224. }
  1225.  
  1226. void
  1227. siLsgc_on()
  1228. {if (vs_base==vs_top)
  1229.    {vs_base[0]=(sgc_enabled ? Ct :Cnil);
  1230.     vs_top=vs_base+1; return;}
  1231.  check_arg(1);
  1232.  if(vs_base[0]==Cnil)
  1233.      {sgc_quit();}
  1234.  else {sgc_start();}}
  1235.  
  1236.  
  1237. /* make permanently writable pages containing pointers p thru p+n-1 */
  1238.    
  1239.    
  1240. void
  1241. perm_writable(p,n)
  1242.      char *p;
  1243.      int n;
  1244. {int beg=page(p);
  1245.  int end=page(PAGE_ROUND_UP(p+n));
  1246.  int i,must_protect=0;
  1247.  beg = ROUND_DOWN_PAGE_NO(beg);
  1248.  end = ROUND_UP_PAGE_NO(end);
  1249.  for (i=beg ; i < end ; i++)
  1250.    {if (sgc_enabled & !(WRITABLE_PAGE_P(i))) must_protect = 1;
  1251.     sgc_type_map [i] |= SGC_PERM_WRITABLE;}
  1252.  if(must_protect) make_writable(beg,end);}
  1253.  
  1254.  
  1255.  
  1256. system_error()
  1257. {FEerror("System error");}
  1258.  
  1259.  
  1260.  
  1261.